# loading libraries
library(tidyverse)
library(leaflet)
library(sf)
# import csv data on cities with TED talks to later combine with shapefile
ted_raw <- readxl::read_excel("../raw_data/ted.xlsx") %>%
mutate(city = str_replace(city, "durham, nc", "durham"))
# narrow down TED data to Americas and Asia, and use that to build countries sf (sf for animation, not leaflet)
sf_cities_aa <- ted_raw %>%
filter(macro_region %in% c("Americas", "Asia")) %>%
mutate(country = str_to_title(country),
city = str_to_title(city)) %>%
st_as_sf(coords = c("lon", "lat"), remove = F, crs = 4326, agr = "constant") %>%
group_by(year, city, lat) %>%
mutate(yearly_count = n()) %>%
ungroup() %>%
select(3:7, 16:18) %>%
unique()
Import shapefile of all countries: File came from the State Department and I used Mapshaper to reduce the file size using the Simplify option
sf_world <- read_sf("../raw_data/Department of State Large-Scale International Boundary (LSIB)/Department of State Large-Scale International Boundary (LSIB).shp") %>%
mutate(Name = str_to_title(Name)) %>%
mutate(Name = str_squish(Name))
Create countries sf from TED cities data + world sf
# To create the choropleth country map for the Americas and Asia: convert sf back to csv (and further below back to sf) of just countries from cities_aa that include the total number of talks by country (2009-2018)
sf_countries_aa <- sf_cities_aa %>%
tbl_df() %>%
select(country, year) %>%
group_by(year, country) %>%
mutate(total_yrly = n()) %>%
ungroup() %>%
unique() %>%
mutate(country = str_squish(country)) %>%
group_by(country) %>%
mutate(total = sum(total_yrly)) %>%
ungroup()
# Now need spatial geometry for each country in Americas and Asia from sf_world. Only using countries in narrowed-down sf_countries_aa df so need to make sure country names match in both. If not, change the name in sf_world. See what's in sf_countries_aa that's not in sf_world.
setdiff(sf_countries_aa$country, sf_world$Name)
## [1] "Myanmar (Burma)" "Hong Kong" "Aruba"
## [4] "Trinidad And Tobago" "Puerto Rico" "Bermuda"
## [7] "Curaã§Ao" "Macao" "Cayman Islands"
## [10] "Maldives" "British Virgin Islands" "Saint Kitts And Nevis"
## [13] "Antigua And Barbuda" "Greenland"
# [1] "Myanmar (Burma)" "Hong Kong"
# [3] "Aruba" "Trinidad And Tobago"
# [5] "Puerto Rico" "Bermuda"
# [7] "Curaã§Ao" "Macao"
# [9] "Cayman Islands" "Maldives"
# [11] "British Virgin Islands" "Saint Kitts And Nevis"
# [13] "Antigua And Barbuda" "Greenland"
# Fix spelling: Rename Curaã§Ao to Curaçao in sf_countries_aa, and reformat others
sf_countries_aa <- sf_countries_aa %>%
mutate(country = str_replace(country, "Trinidad And Tobago", "Trinidad and Tobago")) %>% # old, new
mutate(country = str_replace(country, "Curaã§Ao", "Curaçao")) %>%
mutate(country = str_replace(country, "Saint Kitts And Nevis", "Saint Kitts and Nevis")) %>%
mutate(country = str_replace(country, "Antigua And Barbuda", "Antigua and Barbuda"))
# Check for new and old value
subset(sf_countries_aa, grepl("Curaçao", country)) # yes, 3 rows
## # A tibble: 3 x 4
## country year total_yrly total
## <chr> <chr> <int> <int>
## 1 Curaçao 2015 1 4
## 2 Curaçao 2018 1 4
## 3 Curaçao 2016 2 4
subset(sf_countries_aa, grepl("Curaã§Ao", country)) # none, good
## # A tibble: 0 x 4
## # … with 4 variables: country <chr>, year <chr>, total_yrly <int>, total <int>
# Rename values in sf_world to match what's in sf_countries_aa (will have to manually look it up using View() and then right_join() with sf_countries_aa to make the latter a sf and eliminate geometries from sf_world to only what's in sf_countries_aa
sf_countries_aa <- sf_world %>%
mutate(Name = str_replace_all(Name, c("Burma" = "Myanmar \\(Burma\\)", # old (sf_world) = new (i.e. what's in sf_countries_aa), 2 countries not in sf
"Hong Kong \\(China\\)" = "Hong Kong",
"Aruba \\(Neth\\)" = "Aruba",
"Trinidad & Tobago" = "Trinidad and Tobago",
"Puerto Rico \\(Us\\)" = "Puerto Rico",
"Bermuda \\(Uk\\)" = "Bermuda",
"Macau \\(China\\)" = "Macao",
"Cayman Islands \\(Uk\\)" = "Cayman Islands",
"Virgin Islands \\(Uk\\)" = "British Virgin Islands",
"Saint Kitts & Nevis" = "Saint Kitts and Nevis",
"Antigua & Barbuda" = "Antigua and Barbuda",
"Greenland \\(Denmark\\)" = "Greenland"))) %>%
right_join(sf_countries_aa, by=c("Name"="country"))
# spread yearly country count for tooltip, include yearly count + total count for each country
sf_countries_aa_wide <- sf_countries_aa %>%
select(1:4, total, everything()) %>%
spread(year, total_yrly) %>%
mutate_all(~replace(., is.na(.), 0))
# make cities_aa suitable for leaflet mapping by adding yearly totals for tooltips
sf_cities_aa_wide <- sf_cities_aa %>%
tbl_df() %>%
group_by(city, country, lat) %>% # nyc has multiple lat/lon so need to differentiate for counts
mutate(city_total = sum(yearly_count)) %>%
ungroup() %>%
select(country, city, lat, lon, city_total, year, yearly_count) %>%
spread(year, yearly_count) %>%
mutate_all(~replace(., is.na(.), 0))
Prep
country_bins <- c(0, 1, 100, 250, 500, 4000)
country_pal <- colorBin("Reds", domain = sf_countries_aa_wide$total, bins = country_bins)
# country tooltip
country_label <- sprintf(
"<span style='font-size:1.2em; color:#E62B1E;'><b>%s</b></span>
<br /><b>Total Talks</b>: %g
<hr style='background-color:#E62B1E; height: 1px; border:none'>
<b>2009</b>: %g
<br /><b>2010</b>: %g
<br /><b>2011</b>: %g
<br /><b>2012</b>: %g
<br /><b>2013</b>: %g
<br /><b>2014</b>: %g
<br /><b>2015</b>: %g
<br /><b>2016</b>: %g
<br /><b>2017</b>: %g
<br /><b>2018</b>: %g",
sf_countries_aa_wide$Name,
sf_countries_aa_wide$total,
sf_countries_aa_wide$`2009`,
sf_countries_aa_wide$`2010`,
sf_countries_aa_wide$`2011`,
sf_countries_aa_wide$`2012`,
sf_countries_aa_wide$`2013`,
sf_countries_aa_wide$`2014`,
sf_countries_aa_wide$`2015`,
sf_countries_aa_wide$`2016`,
sf_countries_aa_wide$`2017`,
sf_countries_aa_wide$`2018`
) %>% lapply(htmltools::HTML)
# label format
country_label_style <- labelOptions( # tooltip format
style = list("font-weight" = "normal", "font-family" = "Helvetica", padding = "4px 8px"),
textsize = "14px",
direction = "auto")
# city tooltip
city_label <- sprintf(
"<span style='font-size:1.2em; color:#E62B1E;'><b>%s, %s</b></span>
<br /><b>Total Talks</b>: %g
<hr style='background-color:#E62B1E; height: 1px; border:none'>
<b>2009</b>: %g
<br /><b>2010</b>: %g
<br /><b>2011</b>: %g
<br /><b>2012</b>: %g
<br /><b>2013</b>: %g
<br /><b>2014</b>: %g
<br /><b>2015</b>: %g
<br /><b>2016</b>: %g
<br /><b>2017</b>: %g
<br /><b>2018</b>: %g",
sf_cities_aa_wide$city,
sf_cities_aa_wide$country,
sf_cities_aa_wide$city_total,
sf_cities_aa_wide$`2009`,
sf_cities_aa_wide$`2010`,
sf_cities_aa_wide$`2011`,
sf_cities_aa_wide$`2012`,
sf_cities_aa_wide$`2013`,
sf_cities_aa_wide$`2014`,
sf_cities_aa_wide$`2015`,
sf_cities_aa_wide$`2016`,
sf_cities_aa_wide$`2017`,
sf_cities_aa_wide$`2018`
) %>% lapply(htmltools::HTML)
# chart on popup:
# https://stackoverflow.com/questions/32352539/plotting-barchart-in-popup-using-leaflet-library
# https://stackoverflow.com/questions/58606560/r-leaflet-popupgraph-addpopupgraphs-on-map-marker-click
# https://github.com/r-spatial/leafpop
Function to generate line chart when clicking a country
# function to generate line chart for each country
# https://stackoverflow.com/questions/58606560/r-leaflet-popupgraph-addpopupgraphs-on-map-marker-click
country_line <- function(x) {
sf_countries_aa_wide %>%
filter(Name == x) %>%
gather(years, total_yrly, `2009`:`2018`) %>%
ggplot() +
geom_line(aes(years, total_yrly), group=1, color="#E62B1E") +
theme_minimal() +
theme(plot.title = element_text(size = rel(2), family="Helvetica", face="bold", color="#E62B1E"),
axis.title.y = element_text(family="Helvetica", color="#E62B1E")) +
labs(
x = "",
y = "TED Talks",
title = x)
}
line_popup <- lapply(sf_countries_aa_wide$Name, country_line)
Line graph does not appear properly when clicking on a country.
leaflet() %>%
#setView(-85.6024, 12.7690, zoom = 2) %>%
setView(0,0, zoom = 2) %>%
#addProviderTiles("Esri.WorldTerrain") %>%
addProviderTiles("CartoDB.DarkMatterNoLabels") %>%
addPolygons(data=sf_countries_aa_wide,
weight=1,
color = "black",
fillColor = ~country_pal(total),
fillOpacity=1,
label = country_label,
labelOptions = country_label_style,
group = "Countries"
) %>%
leafpop::addPopupGraphs(line_popup, group = "Countries") %>%
addCircleMarkers(data = sf_cities_aa_wide,
~as.numeric(lon), ~as.numeric(lat),
stroke = F,
radius = ~sqrt(city_total),
fillColor = "black",
label = city_label,
labelOptions=country_label_style,
group = "Cities",
fillOpacity = 0.5) %>%
addLayersControl( # https://rstudio.github.io/leaflet/showhide.html
overlayGroups = "Cities",
options = layersControlOptions(collapsed = F)
)
Code only
# gganimate:
# https://stackoverflow.com/questions/57734180/cumulative-points-over-year-on-map-with-r-ggplot2-and-ggplotly
# https://www.aliesdataspace.com/2019/05/animation-station/
# https://stackoverflow.com/questions/49155038/how-to-save-frames-of-gif-created-using-gganimate-package
library(gganimate)
library(gifski)
# to manually set dimensions of animated map
options(gganimate.dev_args = list(width = 12, height = 5.5, units = 'in', res=300))
anime <- ggplot() +
geom_sf(data=sf_world, fill="black", color="white", size=0.25) +
geom_sf(data=sf_cities_aa, size=2, alpha=0.4, stroke = 0, color="#E62B1E", show.legend=F) +
theme_void() +
coord_sf(crs=st_crs(sf_countries_aa),
#xlim = c(-180, -10),
) +
gganimate::transition_states(sf_cities_aa$year, transition_length = 0, state_length = 1) +
labs(title = "{closest_state}") +
theme(plot.title = element_text(size = rel(2), color="#E62B1E"),
text = element_text(family="Helvetica", face="bold")) +
gganimate::shadow_mark()
#gganimate::anim_save("output_data/ted_map.gif", renderer = gifski_renderer())
# if last line of anim_save() doesn't work, comment it out, save ggplot() as anime (or whatever), run line below, then if you run above (with anim_save()) it might work
#animate(anime, renderer = gifski_renderer("output_data/ted_map.gif"))